DOpus Plus/DOpus Plus.iso/Tools/PPaint64/Rexx/Slideshow.pprx

Text File | 1996-08-29 | 4.9 KB | 197 lines

/* PPaint Amiga Rexx script - Copyright © 1995 Cloanto Italia srl */
/* Slideshow.pprx: simple slideshow program */


MYPORT = 'PPAINT'

IF ~SHOW('P', MYPORT) THEN DO
    IF EXISTS('PPaint:PPaint') THEN DO
        ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
        DO 30 WHILE ~SHOW('P',MYPORT)
             ADDRESS COMMAND 'Wait >NIL: 1 SEC'
        END
    END
    ELSE DO
        SAY "Personal Paint could not be loaded."
        EXIT 10
    END
END

IF ~SHOW('P', MYPORT) THEN DO
    SAY 'Personal Paint Rexx port could not be opened.'
    EXIT 10
END

ADDRESS VALUE MYPORT
OPTIONS RESULTS
OPTIONS FAILAT 10000

Version 'REXX'
IF RESULT < 2 THEN DO
    errmess = 'This script requires a newer_version of Personal Paint.'
    SAY errmess
    RequestNotify 'PROMPT="'errmess'"'
    EXIT 10
END

Get 'LANG'
IF RESULT = 1 THEN DO        /* Deutsch */
    txt_title_filreq  = 'Grafikverzeichnis auswählen'
    txt_title_options = 'Diaschau-Optionen'
    txt_gad_repeat    = 'Wiede_rholen:'
    txt_gad_auto      = 'Auto_matisch:'
    txt_msg_stopped   = 'Diaschau wurde unterbrochen.'
    txt_msg_complete  = 'Diaschau beendet.'
    txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich.'
    txt_err_nolist    = 'Listendatei konnte nicht_geöffnet werden.'
END
ELSE IF RESULT = 3 THEN DO    /* Français */
    txt_title_filreq  = 'Choisir le répertoire des graphismes'
    txt_title_options = 'Options de diaporama'
    txt_gad_repeat    = '_Répéter :'
    txt_gad_auto      = 'Auto_matique :'
    txt_msg_stopped   = 'Le diaporama a été interrompu.'
    txt_msg_complete  = 'Diaporama terminé.'
    txt_err_oldclient = 'Ce script nécessite une nouvelle_version de Personal Paint.'
    txt_err_nolist    = "Impossible d'ouvrir le fichier de liste."
END
ELSE IF RESULT = 2 THEN DO    /* Italiano */
    txt_title_filreq  = 'Selezionare cassetto immagini'
    txt_title_options = 'Opzioni slideshow'
    txt_gad_repeat    = '_Ripetuto:'
    txt_gad_auto      = 'Auto_matico:'
    txt_msg_stopped   = 'Lo slideshow è stato interrotto.'
    txt_msg_complete  = 'Slideshow terminato.'
    txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint.'
    txt_err_nolist    = 'Il file indice non può essere aperto.'
END
ELSE DO                /* English */
    txt_title_filreq  = 'Select artwork directory'
    txt_title_options = 'Slideshow Options'
    txt_gad_repeat    = '_Repeat:'
    txt_gad_auto      = 'Auto_matic:'
    txt_msg_stopped   = 'The slideshow has been stopped.'
    txt_msg_complete  = 'Slideshow complete.'
    txt_err_oldclient = 'This script requires a newer_version of Personal Paint.'
    txt_err_nolist    = 'List file could not be opened.'
END

Version 'REXX'
IF RESULT < 4 THEN DO
    SAY txt_err_oldclient
    RequestNotify 'PROMPT="'txt_err_oldclient'"'
    EXIT 10
END

DelFrames 'ALL'
IF RC = 5 THEN
    EXIT 0

FreeEnv 'QUERY'
IF RC = 5 THEN
    EXIT 0

tmpfname = 'T:pprx_slideshow.list'

LockGUI

IF ~EXISTS(tmpfname) THEN DO
    RequestPath '"'txt_title_filreq'"'
    IF RC = 0 THEN DO
        tmpfname = 'T:pprx_temp.'PRAGMA('ID')
        ADDRESS COMMAND 'List >'tmpfname' 'RESULT' NOHEAD PAT=~(#?.info) LFORMAT="*"%s%s*"*N1" ALL FILES'
    END
END

originalbars = ''
listopen = 0
SIGNAL ON Break_C

IF EXISTS(tmpfname) THEN DO
    Request '"'txt_title_options'" "CHECK = ""'txt_gad_repeat'"", 0  CHECK = ""'txt_gad_auto'"", 1 "'
    IF RC = 0 THEN DO
        repeat = RESULT.1
        automatic = RESULT.2
        IF automatic THEN
            noprog = ''
        ELSE
            noprog = 'NOPROGRESS'

        Get SETTING BARS
        originalbars = RESULT
        IF OPEN('listfile', tmpfname , R) THEN DO
            listopen = 1
            errcode = 0
            Set '"BARS=0"'
            DO FOREVER
                prevpos = SEEK('listfile', 0, CURRENT)
                curfname = READLN('listfile')
                IF EOF('listfile') THEN DO
                    IF repeat THEN DO
                        SEEK('listfile', 0, BEGIN)
                        ITERATE
                    END
                    ELSE LEAVE
                END
                curtimes = READLN('listfile')
                IF EOF('listfile') THEN DO
                    IF repeat THEN DO
                        SEEK('listfile', 0, BEGIN)
                        ITERATE
                    END
                    ELSE LEAVE
                END

                IF DATATYPE(curtimes) ~= 'NUM' THEN curtimes = 1
                curtimes = ABS(curtimes)
                curtimes = TRUNC(curtimes)
                IF curtimes < 1 THEN curtimes = 1

                GetFileFormat curfname
                IF RC = 0 THEN DO
                    IF UPPER(RESULT) = 'ANIM' THEN
                        PlayFile curfname 'TIMES' curtimes 'FORCE QUIET' noprog
                    ELSE DO
                        LoadImage curfname 'FORCE QUIET' noprog
                        IF RC = 0 & automatic THEN
                            ADDRESS COMMAND 'Wait >NIL: 3 SEC'
                    END
                    IF RC = 5 THEN
                        errcode = 5
                    IF RC = 0 & ~automatic THEN DO
                        WaitForClick
                        IF RC ~= 0 THEN
                            errcode = 5
                    END
                END
                IF errcode > 0 THEN BREAK
            END
            CALL CLOSE('listfile')
            listopen = 0
            IF errcode > 0 THEN
                RequestNotify 'PROMPT="'txt_msg_stopped'"'
            ELSE
                RequestNotify 'PROMPT="'txt_msg_complete'"'
        END
        ELSE
            RequestNotify 'PROMPT="'txt_err_nolist'"'

        Set '"BARS='originalbars'"'
    END
    ADDRESS COMMAND 'Delete >NIL: 'tmpfname
END
UnlockGUI
EXIT 0



Break_C:

    if originalbars ~= '' THEN
        Set '"BARS='originalbars'"'
    IF listopen THEN
        CALL CLOSE('listfile')
    ADDRESS COMMAND 'Delete >NIL: 'tmpfname

    RETURN